home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 June / MacFormat 25.iso / Shareware City / Developers / Little Smalltalk v3.1.4 / Smalltalk Source / browser.st < prev    next >
Encoding:
Text File  |  1995-01-24  |  7.6 KB  |  285 lines  |  [TEXT/KAHL]
  1. * ***
  2. * Methods for a class browser
  3. *
  4. * Julian Barkway (c) September 1994 All rights reserved. 
  5. *
  6. * v3.1.0    Initial release
  7. * v3.1.1    -
  8. * v3.1.2    - Changed to allow for different actions for double and single clicks.
  9. *            - Increased use of cascades.
  10. *            - addSubClass:instanceVariableNames: patched to let through embedded
  11. *              digits.
  12. * v3.1.3    - Dictionary pane no longer gives error if clicked on when empty.
  13. *
  14. * ***
  15. Class    BrowserWindow Window browser
  16. Class    DictionaryPane SelectListPane dict
  17. Class    Browser Object theClass method compile classPMenu methodPMenu textAreaPMenu cp mp tp
  18.  
  19. *
  20. * addSubClass:... patched so that it doesn't remove numbers embedded in instance 
  21. * variable names.  The downside is that it will let through some illegal names, but 
  22. * since the compiler will trap these when they are used it probably isn't too bad a
  23. * side-effect.
  24. *
  25. Methods Class 'creation'
  26.     addSubClass: aSymbol instanceVariableNames: aString    | newClass |
  27.         newClass <- Class new; name: aSymbol; superClass: self;
  28.                 variables: 
  29.                   (aString words: [:x | x isAlphaNumeric ]).
  30.         aSymbol assign: newClass.
  31.         classes at: aSymbol put: newClass
  32. ]
  33.  
  34. *
  35. * We sub-class Window to allow the 'close' message to be neatly trapped without
  36. * needing to make Browser a sub-class of Window (which it clearly isn't)
  37. * 
  38. Methods BrowserWindow 'all'
  39.     openAt: aPosition withSize: aSize
  40.         (title = '') ifTrue: [       " Only false when restoring a saveImage'd window "
  41.             self title: 'Browser ' , (nextBrowserNum asString).
  42.             nextBrowserNum <- nextBrowserNum + 1
  43.         ].
  44.         super openAt: aPosition withSize: aSize
  45. |
  46.     close    | reply |
  47.         (self wantsSave) ifTrue: [
  48.             reply <- smalltalk inquire: ('Save contents of window ', self title, '?').
  49.             (reply isNil) ifTrue: [                "Note: can return nil for Cancel"
  50.                 ^ nil
  51.             ]. 
  52.             reply  ifTrue: [
  53.                 ((self mainPane) saveContents: 1) ifFalse: [
  54.                     ^ nil            "User cancelled save operation"
  55.                 ]
  56.             ]
  57.         ].
  58.         super close.
  59.         browser close
  60. |
  61.     browser: aBrowser
  62.         browser <- aBrowser.
  63. ]
  64.  
  65. Methods DictionaryPane 'all'
  66.     dictionary: aDictionary
  67.         dict <- aDictionary.
  68. |
  69.     dictionary
  70.         ^ dict
  71. |
  72.     setText | t |
  73.         t <- '------------------' , newLine.
  74.         dict binaryDo: [:a :b |
  75.             t <- t , (a asString) , newLine
  76.         ].
  77.         t <- t , '------------------'.
  78.         self clearAllText.
  79.         self text: t
  80. |
  81.     getSelectedItem | t |            " Changed for v3.1.3 "
  82.         dict isNil ifTrue: [
  83.             ^ nil
  84.         ].
  85.         t <- self selectedText.
  86.          ( (t = '------------------') or:
  87.            [t = ('------------------' , newLine) ]) ifTrue: [
  88.             ^ nil
  89.         ].
  90.         t <- t copyFrom: 1 to: ((t size) - 1).
  91.         dict binaryDo: [:a :b |
  92.             ((t asSymbol) == a) ifTrue: [
  93.                 ^ b 
  94.             ]
  95.         ]
  96. ]
  97.  
  98. Methods Browser 'all'
  99.     new | bwin maxW maxH | 
  100.         maxW <- (smalltalk getMaxScreenArea) right.
  101.         maxW <- 450 min: (maxW - 70).
  102.         maxH <- (smalltalk getMaxScreenArea) bottom.
  103.         maxH <- 500 min: (maxH - 70).
  104.         bwin <- BrowserWindow new; 
  105.             browser: self;
  106.             openAt: (20@60) withSize: (maxW@maxH).
  107.         self makeClassPopUpMenu.
  108.         self makeMethodPopUpMenu.
  109.         self makeTextAreaPopUpMenu.
  110.         self makePanes: bwin.
  111. |
  112.     makePanes: bwin        | ww wh ph pw |
  113.         ww <- (bwin size) x.
  114.         wh <- (bwin size) y.
  115.         pw <- (ww / 2) truncated.
  116.         ph <- (wh / 5) truncated.
  117.         cp <- DictionaryPane new;
  118.             dictionary: classes;
  119.             boundsFrom: (-1 @ -1) to: (pw @ ph);
  120.             attachTo: bwin withSizing: (0 @ 0).
  121.         mp <- DictionaryPane new;
  122.             boundsFrom: ((pw - 1) @ -1) to: ((ww + 1) @ ph);
  123.             attachTo: bwin withSizing: (1 @ 0).
  124.         tp <- TextPane new;
  125.             boundsFrom: (-1 @ (ph - 1)) to: ((ww + 1) @ (wh + 1));
  126.             attachTo: bwin withSizing: (1 @ 1).
  127. |
  128.     open
  129.         cp font: 'geneva'; fontSize: 9; typeFace: 2;
  130.             button1Action: [:p | 
  131.                 mp clearAllText. 
  132.                 classPMenu enableItem: 1; enableItem: 2; enableItem: 3.
  133.                 "classPMenu enableItem: 4." "Class removal disabled for now..."
  134.                 methodPMenu disableItem: 1; disableItem: 2.
  135.                 self cancel
  136.             ];
  137.             button2Action: [:p | classPMenu popUpAt: p ];
  138.             button1DoubleClick: [:p | self selectClass: (cp getSelectedItem) ].
  139.         mp font: 'geneva'; fontSize: 9; typeFace: 2;
  140.             button1Action: [:p | 
  141.                 self cancel.
  142.                 methodPMenu enableItem: 2
  143.             ];
  144.             button2Action: [:p | methodPMenu popUpAt: p ];
  145.             button1DoubleClick: [:p | self selectMethod: (mp getSelectedItem) ].
  146.         tp font: 'monaco'; fontSize: 9;
  147.             button2Action: [:p | textAreaPMenu popUpAt: p ].
  148.         cp setText
  149. |
  150.     close
  151.         " close our window and remove the pop-up menus"
  152.         classPMenu dispose.
  153.         methodPMenu dispose.
  154.         textAreaPMenu dispose
  155. |
  156.     selectClass: c
  157.         (c notNil) ifTrue: [
  158.             theClass <- c.
  159.             self showMethods
  160.         ].
  161.         methodPMenu enableItem: 1; disableItem: 2.
  162. |
  163.     showMethods
  164.         mp dictionary: (theClass methods).
  165.         mp setText
  166. |
  167.     selectMethod: m
  168.         (m notNil) ifTrue: [
  169.             method <- m.
  170.             tp print: m text.
  171.             compile <- true
  172.         ].
  173.         textAreaPMenu enableItem: 1; enableItem: 2
  174. |
  175.     makeClassPopUpMenu
  176.         classPMenu <- PopUpMenu new; 
  177.             title: '';
  178.             create.
  179.         classPMenu addItem: 'Browse Class' 
  180.                         action: [ self browseClass: (cp getSelectedItem) ];
  181.                    addItem: 'Inspect Class' 
  182.                         action: [ (cp getSelectedItem) inspect ];
  183.                    addItem: 'Add New Class'
  184.                         action: [ self addClass ];
  185.                    addItem: 'Remove Class'
  186.                         action: [ self removeClass: (cp getSelectedItem) ];
  187.                    disableItem: 1; disableItem: 4.
  188. |
  189.     makeMethodPopUpMenu
  190.         methodPMenu <- PopUpMenu new; 
  191.             title: '';
  192.             create.
  193.         methodPMenu addItem: 'Add New Method'
  194.                         action: [ self addMethod ];
  195.                     addItem: 'Remove Method'
  196.                         action: [ self removeMethod: (mp getSelectedItem) ];
  197.                     disableItem: 1; disableItem: 2.
  198. |
  199.     makeTextAreaPopUpMenu
  200.         textAreaPMenu <- PopUpMenu new; 
  201.             title: '';
  202.             create.
  203.         textAreaPMenu addItem: 'Accept' action: [ self accept ];
  204.                       addItem: 'Cancel' action: [ self cancel ];
  205.                       disableItem: 1;
  206.                       disableItem: 2.
  207.         compile <- true
  208. |
  209.     browseClass: c    | iv |
  210.         " browse the given class "
  211.         (c notNil) ifTrue: [
  212.             tp clearAllText;
  213.                print: (c superClass) printString , ' addSubClass: #' , 
  214.                         c printString, newLine;
  215.                print: '   instanceVariableNames: '''.
  216.             iv <- c variables.
  217.             (iv notNil) ifTrue: [
  218.                 iv do: [ :var | tp print: ((var asString) , ' ') ]
  219.             ].
  220.             tp print: ''''.
  221.             theClass <- c.
  222.             compile <- false
  223.         ].
  224.         textAreaPMenu disableItem: 1; enableItem: 2.
  225. |
  226.     addClass    
  227.         " add a new class "
  228.         tp clearAllText;
  229.            print: 'superClass addSubClass: #nameOfClass ', newLine,
  230.                    '  instanceVariableNames: ''var1 var2'' '.
  231.         compile <- false.
  232.         textAreaPMenu enableItem: 1; enableItem: 2.
  233. |
  234.     removeClass: c    
  235.         " Will remove class from symbols dictionary
  236.           when we can figure out how... It's not just 
  237.           a simple matter of invoking removeKey: "
  238.         ^ nil
  239. |
  240.     addMethod
  241.         method <- Method new.
  242.         tp clearAllText.
  243.         tp print: '  "A comment stating the method''s function"' , newLine.
  244.         tp print: '  messageSelector: argumentNames " -- argument names optional"', newLine.
  245.         tp print: '    | temporaries | "-- temporaries optional"', newLine.
  246.         tp print: '    body of method', newLine.
  247.         compile <- true.
  248.         textAreaPMenu enableItem: 1.
  249.         textAreaPMenu enableItem: 2.
  250. |
  251.     removeMethod: m | t |
  252.         " Remove given method from currently selected class "
  253.         (m notNil) ifTrue: [
  254.             t <- (smalltalk inquire: 'Remove method ''', (m name), '''?').
  255.             (t isNil) ifTrue: [
  256.                 ^ nil
  257.             ].
  258.             t ifTrue: [
  259.                 (mp dictionary) removeKey: (m name).
  260.                 mp setText.
  261.                 methodPMenu disableItem: 2
  262.             ]
  263.         ]
  264. |
  265.     accept
  266.         compile ifTrue:  [ self compile   ]
  267.                 ifFalse: [ self doCommand ]
  268. |
  269.     cancel
  270.         tp clearAllText.
  271.         textAreaPMenu disableItem: 1.
  272.         textAreaPMenu disableItem: 2.
  273.  
  274. |
  275.     compile
  276.         method text: (tp text).
  277.         (method compileWithClass: theClass)
  278.             ifTrue: [ theClass methods at: method name put: method.
  279.                 mp setText ].
  280. |
  281.     doCommand
  282.         " accept tw command "
  283.         [ tp text execute. cp setText ] fork.
  284. ]
  285.